perm filename PLTIT.OLD[MSS,LCS] blob sn#131223 filedate 1974-11-15 generic text, type T, neo UTF8
C**** PLTCMD, FILLMS, ROTATE ********
	SUBROUTINE PLTCMD
CC	IMPLICIT INTEGER(A-Q,S-Z)
	COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK
	DIMENSION NMS(8),RMOV1(8),RMOV2(8)
	COMMON /DL/RSIZ,SAVER,NAME /ALF/INP(72),ML
	COMMON RJB,JE,CENTR,JB,RJQ(20),JQ(20)
	EQUIVALENCE (RJE,RJQ(3)),(RJF,RJQ(4)),(RJG,RJQ(5)),(RJD,RJQ(2))
	1,(RJC,RJQ(1)),(I2,INP(2)),(RJH,RJQ(6)),(NMS(1),INP(31))
	1,(RMOV1(1),INP(39))
C  BE CAREFUL OF COMMON OVERLAPS WITH NOTWRT,ITMSUB,HOMER, ETC.
CC	1,(RMOV1(1),INP(21)),(RMOV2(1),INP(31))
	F78F(1)='(78F)'
	FA5(1)='(A5) '
	FA1(1)='(A1) '

	IF(I2.NE.'X')GO TO 1
	I2=0
	RXC=0
	RMOV1(1)='Y'
	NAME=0
14	KA=0
3	KA=KA+1
	IF(ML.EQ.0)GO TO 15
	K=K-2
	ML=ML-1
	IF(ML.EQ.0)GO TO 10
	GO TO 31
15	TYPE 2,KA
	ACCEPT 11,K,ML
C  TYPE LAST NAME, NUMBER  FOR A SERIES
50	IF(K.EQ.' ')GO TO 10
	IF(K.EQ.'99')GO TO 140
C  99=BACKUP
31	IF(LOOKD(K))GO TO 56
C JUMP IF FILE FOUND
	TYPE 55
	GO TO 15
55	FORMAT(' FILE NOT FOUND'/)
11	FORMAT(A5,I)
56	NMS(KA)=K
	IF(ML.EQ.0)GO TO 5
	RJH='Y'
	GO TO 21
5	TYPE 8
	ACCEPT FA5,RJH
	IF(RJH.EQ.'99')GO TO 15
	IF(RJH.NE.'Y')RJH=0
	IF(RJH.EQ.0)REREAD F78F,RJH
C  MOVE NUMBER CAN BE TYPED FOR 'MOVE UP'
21	RMOV1(KA+1)=RJH
	RMOV2(KA)=RJH
	GO TO 3
140	KA=KA-1
	GO TO 15

10	KB=KA-1
	IF(I3.NE.'G')GO TO 22
	RSIZ=1
	GO TO 222
22	TYPE 9
	ACCEPT F78F,RSIZ
	IF(RSIZ.EQ.99.OR.RSIZ.EQ.0)GO TO 5
222	KA=0

1	IF(NAME.NE.0)GO TO 12
	IF(KA.EQ.KB)CALL PLOT(0,0,99)
	NAME=NMS(KA+1)
	TYPE 111,NAME
	RETURN
12	KA=KA+1
	NAME=0
C  'PXC' = CALCOMP OUTPUT
	RJH=0
	RJB=RSIZ
	RJC=RSIZ
C  FOR FILLER.  SIZES .LT. 1.6 = EVERY SCAN LINE, .LT. 2.6 = 2, ETC.
	RJG=0
	RJE=1
	RJF=1
	IF(RMOV2(KA).NE.'Y')RJG=RMOV2(KA)
	IF(RMOV1(KA).NE.0)RJE=0
	IF(RMOV2(KA).NE.0.OR.RJG.NE.0)RJF=0
2	FORMAT(' TYPE FILE NAME',I2,1X$)
8	FORMAT(' MOVE UP AT END? ',$)
9	FORMAT(' SIZE FACTOR? ',$)
111	FORMAT(1XA5/)
	END



C******   CHANGE 3, 4 AND 5 TO JFCL IN DDT WHEN USING DISTORTION.(SEE 'LINES')
	SUBROUTINE FILLMS(L,IDAT,RJB,CENTR,RJF,RJG)
	COMMON/DL/RSIZ,SAVER,NAME
	COMMON/DST/BB,CC/FLM/X(200),Y(200),NX(200)
	DIMENSION IDAT(1)
	COMMON/PLTR/IPLT,RHT,DIS/LL/LL/STF/RR(8),RSTJC
C MD=DISPLAY   MP=PLOTTER   MX=XGP
	DX=DIS
	RX=RHT
	D=RSTJC*RJF
	R=RSTJC*RJG
4	GO TO 1
	C=CC
	B=BB
C  SAVES IT.  IT WILL RETURN LATER.
	BB=B/DIS
	CC=1000
1	KK=0
	DO 205 J=1,L
	CALL UNPACK(M,N,IDAT(J))
	KK=KK+1
	NX(KK)=0
	IF(LL.EQ.3)NX(KK)=3
	X(KK)=ROFF((RJB+D*M)*DIS)
	Y(KK)=ROFF((CENTR+R*N)*RHT)
3	GO TO 205
	Y(KK)=Y(KK)*(C-BB*(ABS(X(KK))))
C  FOR DISTORTION
205	CONTINUE
	NX(1)=KK
	DIS=1.0
	RHT=DIS
	IF(IPLT)M=RSIZ+.4
	IF(M.LE.0)M=1
C  STOPS DISTORTION IN 'LINES'
2	CALL FILLER(X,Y,NX,M)
	DIS=DX
	RHT=RX
5	RETURN
C  NEXT TO RESET DISTORTION FACT.
	BB=B
	CC=C
	RETURN
	END

	SUBROUTINE ROTATE(I,L)
	DIMENSION I(1)
	COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/STF/RR(8),RSTJC
	EQUIVALENCE (RJF,RJQ(4)),(RJG,RJQ(5)),(DEG,RJQ(7))
	RJG=RJG*RSTJC
	RJF=RJF*RSTJC
	N=I(L)
	KNT=601
C  ROTATED DATA IS PUT BACK STARTING AT LOCATION 601.
	I(KNT)=N
	DO 1 K=L+1,N+L-1
	CALL UNPACK(J,M,I(K))
	X=J*RJF
	Y=M*RJG
	JJ=I(K)/100000000
	AX=ATAN2(X,Y)*57.29578
	HYP=SQRT(X**2+Y**2)
	ROT=DEG+AX
	J=ROFF(HYP*COSD(ROT))
	M=ROFF(HYP*SIND(ROT))
	KNT=KNT+1
	IF(J)J=1000-J
	IF(M)M=1000-M
1	I(KNT)=M*10000+J+JJ*100000000
	L=601
	RJF=1.
	RJG=1.
	RSTJC=1.
C  SIZE CHANGES MUST BE MADE BEFORE ROTATION!!!!! ELSE IT DISTORTS.
	END


	SUBROUTINE PLOT(I,J,K)
	DATA M/1024/
	DIMENSION N(1024)
	IF(K.EQ.99)GO TO 1
	L=L+1
	CALL PAC(N(L),I)
3	IF(L.LT.1024)RETURN
2	WRITE(1)L,N
	L=0
	RETURN
1	WRITE(1)L,(N(K),K=1,L)
	CALL EXIT
	END